# loading in SLICER packages
library("devtools")
install_github("jw156605/SLICER")
library(SLICER)
library(lle)
# finding the number of initial clusters for reconstructing the trajectory
k = select_k(top_genes, kmin = 3)
# performing LLE a form of dimensionality reduction on the gene expression data
# m = 3 bc that is the number of dimensions used in the figures in the paper
traj_lle = lle(top_genes, m=3, k)$Y
# build a knearest neighbor graph to find the distances betwen cells
traj_graph = conn_knn_graph(traj_lle, k)
# constructing the cell order and finding branches in the trajectory
ends = find_extreme_cells(traj_graph, traj_lle)

start = 402 # needs to be changed to a known cardiac fibroblast
cells_ordered = cell_order(traj_graph, start)
graph_process_distance(traj_graph,traj_lle,start)

branches = assign_branches(traj_graph,20, min_branch_len = 10)
Error in if (mean_dist < min_dist) { :
missing value where TRUE/FALSE needed
distances_inactive = process_distance(traj_graph, 402) / 5.241427
distances_active = process_distance(traj_graph, 346) / 9.541308
library(rgl)
library(plotly)
lle_df = data.frame(traj_lle )
lle_df$pseudotime = as.double(t(distances_inactive))
lle_df$active = "CCI"
lle_df[active_cell_numbers,4] = as.double(t(distances_active))[active_cell_numbers]
lle_df[active_cell_numbers,5] = "CCA"
lle_df$active = as.factor(lle_df$active)
lle_df$ident = identified_cells$GroupID_Fig1a
lle_df$ident_2 = cell_categorized$stage
axx <- list(
title = "LLE 1"
)
axy <- list(
title = "LLE 2"
)
axz <- list(
title = "LLE 3"
)
fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, marker = list(size = 6), symbol = ~active, symbols = c("diamond", "circle") )
fig <- fig %>% add_markers(color = ~pseudotime, colors = c('black', 'red', 'orange', 'yellow'))
fig <- fig %>% layout(scene = list(aspectmode = "cube", xaxis=axx,yaxis=axy,zaxis=axz))
fig
inactive_cell_rows = !(1:nrow(lle_df) %in% active_cell_numbers )
lle_df[inactive_cell_rows,]
axx <- list(
title = "LLE 1"
)
axy <- list(
title = "LLE 2"
)
axz <- list(
title = "LLE 3"
)
fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, color = ~ident_2, marker = list(size = 6), symbol = ~active, symbols = c("diamond", "circle") )
fig <- fig %>% add_markers(colors = c('blue', 'red', 'purple', 'lightgreen'))
fig <- fig %>% layout(scene = list(aspectmode = "cube", xaxis=axx,yaxis=axy,zaxis=axz))
fig
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CiMgbG9hZGluZyBpbiBTTElDRVIgcGFja2FnZXMKbGlicmFyeSgiZGV2dG9vbHMiKQppbnN0YWxsX2dpdGh1YigiancxNTY2MDUvU0xJQ0VSIikKbGlicmFyeShTTElDRVIpCmxpYnJhcnkobGxlKQpgYGAKCgpgYGB7cn0KIyBmaW5kaW5nIHRoZSBudW1iZXIgb2YgaW5pdGlhbCBjbHVzdGVycyBmb3IgcmVjb25zdHJ1Y3RpbmcgdGhlIHRyYWplY3RvcnkKayA9IHNlbGVjdF9rKHRvcF9nZW5lcywga21pbiA9IDMpCmBgYApgYGB7cn0KIyBwZXJmb3JtaW5nIExMRSBhIGZvcm0gb2YgZGltZW5zaW9uYWxpdHkgcmVkdWN0aW9uIG9uIHRoZSBnZW5lIGV4cHJlc3Npb24gZGF0YQojIG0gPSAzIGJjIHRoYXQgaXMgdGhlIG51bWJlciBvZiBkaW1lbnNpb25zIHVzZWQgaW4gdGhlIGZpZ3VyZXMgaW4gdGhlIHBhcGVyIAp0cmFqX2xsZSA9IGxsZSh0b3BfZ2VuZXMsIG09MywgaykkWQpgYGAKCgpgYGB7cn0KIyBidWlsZCBhIGtuZWFyZXN0IG5laWdoYm9yIGdyYXBoIHRvIGZpbmQgdGhlIGRpc3RhbmNlcyBiZXR3ZW4gY2VsbHMKdHJhal9ncmFwaCA9IGNvbm5fa25uX2dyYXBoKHRyYWpfbGxlLCBrKQpgYGAKYGBge3J9CiMgY29uc3RydWN0aW5nIHRoZSBjZWxsIG9yZGVyIGFuZCBmaW5kaW5nIGJyYW5jaGVzIGluIHRoZSB0cmFqZWN0b3J5IAplbmRzID0gZmluZF9leHRyZW1lX2NlbGxzKHRyYWpfZ3JhcGgsIHRyYWpfbGxlKQpzdGFydCA9IDQwMiAjIG5lZWRzIHRvIGJlIGNoYW5nZWQgdG8gYSBrbm93biBjYXJkaWFjIGZpYnJvYmxhc3QgCmNlbGxzX29yZGVyZWQgPSBjZWxsX29yZGVyKHRyYWpfZ3JhcGgsIHN0YXJ0KQpncmFwaF9wcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsdHJhal9sbGUsc3RhcnQpCmJyYW5jaGVzID0gYXNzaWduX2JyYW5jaGVzKHRyYWpfZ3JhcGgsMjAsIG1pbl9icmFuY2hfbGVuID0gMTApCmBgYAoKCmBgYHtyfQpkaXN0YW5jZXNfaW5hY3RpdmUgPSBwcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsIDQwMikgLyA1LjI0MTQyNwpkaXN0YW5jZXNfYWN0aXZlID0gcHJvY2Vzc19kaXN0YW5jZSh0cmFqX2dyYXBoLCAzNDYpIC8gOS41NDEzMDgKCmBgYAoKYGBge3J9CmxpYnJhcnkocmdsKQpsaWJyYXJ5KHBsb3RseSkKYGBgCgoKYGBge3J9CmxsZV9kZiA9IGRhdGEuZnJhbWUodHJhal9sbGUgKQpsbGVfZGYkcHNldWRvdGltZSA9IGFzLmRvdWJsZSh0KGRpc3RhbmNlc19pbmFjdGl2ZSkpCmxsZV9kZiRhY3RpdmUgPSAiQ0NJIgpsbGVfZGZbYWN0aXZlX2NlbGxfbnVtYmVycyw0XSA9IGFzLmRvdWJsZSh0KGRpc3RhbmNlc19hY3RpdmUpKVthY3RpdmVfY2VsbF9udW1iZXJzXQpsbGVfZGZbYWN0aXZlX2NlbGxfbnVtYmVycyw1XSA9ICJDQ0EiCmxsZV9kZiRhY3RpdmUgPSBhcy5mYWN0b3IobGxlX2RmJGFjdGl2ZSkKbGxlX2RmJGlkZW50ID0gaWRlbnRpZmllZF9jZWxscyRHcm91cElEX0ZpZzFhCmxsZV9kZiRpZGVudF8yID0gY2VsbF9jYXRlZ29yaXplZCRzdGFnZQoKYWN0aXZlX2NlbGxzCnRvcF9nZW5lc190ZXN0ID0gYXMuZGF0YS5mcmFtZSh0b3BfZ2VuZXMpCnRvcF9nZW5lc190ZXN0JHJvd19udW1iZXIgPSAxOm5yb3codG9wX2dlbmVzX3Rlc3QpCmFjdGl2ZV9jZWxsX251bWJlcnMgPSB0b3BfZ2VuZXNfdGVzdFthY3RpdmVfY2VsbHMsNDAxXQpgYGAKCgpgYGB7cn0KCmF4eCA8LSBsaXN0KAogIHRpdGxlID0gIkxMRSAxIgopCgpheHkgPC0gbGlzdCgKICB0aXRsZSA9ICJMTEUgMiIKKQoKYXh6IDwtIGxpc3QoCiAgdGl0bGUgPSAiTExFIDMiCikKCmZpZyA8LSBwbG90X2x5KGxsZV9kZiwgeCA9IH5YMSwgeSA9IH5YMiwgeiA9IH5YMywgbWFya2VyID0gbGlzdChzaXplID0gNiksIHN5bWJvbCA9IH5hY3RpdmUsIHN5bWJvbHMgPSBjKCJkaWFtb25kIiwgImNpcmNsZSIpICkKZmlnIDwtIGZpZyAlPiUgYWRkX21hcmtlcnMoY29sb3IgPSB+cHNldWRvdGltZSwgY29sb3JzID0gYygnYmxhY2snLCAncmVkJywgJ29yYW5nZScsICd5ZWxsb3cnKSkKZmlnIDwtIGZpZyAlPiUgbGF5b3V0KHNjZW5lID0gbGlzdChhc3BlY3Rtb2RlID0gImN1YmUiLCB4YXhpcz1heHgseWF4aXM9YXh5LHpheGlzPWF4eikpCgpmaWcKYGBgCmBgYHtyfQppbmFjdGl2ZV9jZWxsX3Jvd3MgPSAhKDE6bnJvdyhsbGVfZGYpICAlaW4lIGFjdGl2ZV9jZWxsX251bWJlcnMgKQpsbGVfZGZbaW5hY3RpdmVfY2VsbF9yb3dzLF0KYGBgCgoKCmBgYHtyfQpheHggPC0gbGlzdCgKICB0aXRsZSA9ICJMTEUgMSIKKQoKYXh5IDwtIGxpc3QoCiAgdGl0bGUgPSAiTExFIDIiCikKCmF4eiA8LSBsaXN0KAogIHRpdGxlID0gIkxMRSAzIgopCmZpZyA8LSBwbG90X2x5KGxsZV9kZiwgeCA9IH5YMSwgeSA9IH5YMiwgeiA9IH5YMywgY29sb3IgPSB+aWRlbnRfMiwgbWFya2VyID0gbGlzdChzaXplID0gNiksIHN5bWJvbCA9IH5hY3RpdmUsIHN5bWJvbHMgPSBjKCJkaWFtb25kIiwgImNpcmNsZSIpICkKZmlnIDwtIGZpZyAlPiUgYWRkX21hcmtlcnMoY29sb3JzID0gYygnYmx1ZScsICdyZWQnLCAncHVycGxlJywgJ2xpZ2h0Z3JlZW4nKSkKZmlnIDwtIGZpZyAlPiUgbGF5b3V0KHNjZW5lID0gbGlzdChhc3BlY3Rtb2RlID0gImN1YmUiLCB4YXhpcz1heHgseWF4aXM9YXh5LHpheGlzPWF4eikpCmZpZwpgYGAKCgoKCgo=